home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / WINDEMOS.ZIP / GENERIC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-27  |  3KB  |  113 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { "Generic" Windows application written in Turbo Pascal }
  9.  
  10. program Generic;
  11.  
  12. {$R GENERIC}
  13.  
  14. uses WinTypes, WinProcs;
  15.  
  16. const
  17.   AppName = 'Generic';
  18.  
  19. const
  20.   idm_About = 100;
  21.  
  22. function About(Dialog: HWnd; Message, WParam: Word;
  23.   LParam: Longint): Bool; export;
  24. begin
  25.   About := True;
  26.   case Message of
  27.     wm_InitDialog:
  28.       Exit;
  29.     wm_Command:
  30.       if (WParam = id_Ok) or (WParam = id_Cancel) then
  31.       begin
  32.         EndDialog(Dialog, 1);
  33.         Exit;
  34.       end;
  35.   end;
  36.   About := False;
  37. end;
  38.  
  39. function WindowProc(Window: HWnd; Message, WParam: Word;
  40.   LParam: Longint): Longint; export;
  41. var
  42.   AboutProc: TFarProc;
  43. begin
  44.   WindowProc := 0;
  45.   case Message of
  46.     wm_Command:
  47.       if WParam = idm_About then
  48.       begin
  49.         AboutProc := MakeProcInstance(@About, HInstance);
  50.         DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  51.         FreeProcInstance(AboutProc);
  52.         Exit;
  53.       end;
  54.     wm_Destroy:
  55.       begin
  56.         PostQuitMessage(0);
  57.         Exit;
  58.       end;
  59.   end;
  60.   WindowProc := DefWindowProc(Window, Message, WParam, LParam);
  61. end;
  62.  
  63. procedure WinMain;
  64. var
  65.   Window: HWnd;
  66.   Message: TMsg;
  67. const
  68.   WindowClass: TWndClass = (
  69.     style: 0;
  70.     lpfnWndProc: @WindowProc;
  71.     cbClsExtra: 0;
  72.     cbWndExtra: 0;
  73.     hInstance: 0;
  74.     hIcon: 0;
  75.     hCursor: 0;
  76.     hbrBackground: 0;
  77.     lpszMenuName: AppName;
  78.     lpszClassName: AppName);
  79. begin
  80.   if HPrevInst = 0 then
  81.   begin
  82.     WindowClass.hInstance := HInstance;
  83.     WindowClass.hIcon := LoadIcon(0, idi_Application);
  84.     WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  85.     WindowClass.hbrBackground := GetStockObject(white_Brush);
  86.     if not RegisterClass(WindowClass) then Halt(255);
  87.   end;
  88.   Window := CreateWindow(
  89.     AppName,
  90.     'Turbo Pascal Generic',
  91.     ws_OverlappedWindow,
  92.     cw_UseDefault,
  93.     cw_UseDefault,
  94.     cw_UseDefault,
  95.     cw_UseDefault,
  96.     0,
  97.     0,
  98.     HInstance,
  99.     nil);
  100.   ShowWindow(Window, CmdShow);
  101.   UpdateWindow(Window);
  102.   while GetMessage(Message, 0, 0, 0) do
  103.   begin
  104.     TranslateMessage(Message);
  105.     DispatchMessage(Message);
  106.   end;
  107.   Halt(Message.wParam);
  108. end;
  109.  
  110. begin
  111.   WinMain;
  112. end.
  113.